with System;
with Legend.Timers;
with SDL.Keyboard;
package body Legend.Interactives is

   subtype Virtual is Interactive_Type'Class;

   procedure Process_Message (
      this : in out Interactive_Type'Class;
      message : SDL.Events.Event_t
      )
   is
      cancel_bubble : Boolean := True;
   begin
      Dispatch (this, message, cancel_bubble);
      if not cancel_bubble then
         pragma Compile_Time_Warning(True, "FIXME: bubble Moddel seems NG");
         if this.Parent /= null then
            this.Parent.Dispatch (message, cancel_bubble);
         end if;
      end if;
   exception
      when Error : others =>
         Trace_Log (Ada.Exceptions.Exception_Message (Error));
   end Process_Message;

   procedure On_Timer (
      this          : in out Interactive_Type;
      Timer         : Hash_Type;
      Count         : Natural;
      Cancel_Bubble : in out Boolean
      ) 
   is
   begin
      if timer = this.Timer then
         this.Canvas.Repaint;
      else
         cancel_bubble := False;
      end if;
   end On_Timer;

   function Disable_Input_Filter (
      Message   : SDL.Events.Event_Access_t
      ) return Interfaces.C.int
   is
   begin
      case Message.Ev_Type is
         when SDL.Events.Is_User_Event | SDL.Events.Quit => return 1;
         when others => return 0;
      end case;
   end Disable_Input_Filter;

   procedure Trap_Timer (
      Message : SDL.Events.Event_t;
      Process : access procedure (Timer : Hash_Type; Count : Natural) := null
      )
   is
      pragma Warnings(Off);
      h : Hash_Type with Import, Convention => Ada, 
      Address => Message.User.Data1'Address;
      n : Natural with Import, Convention => Ada,
      Address => Message.User.Data2'Address;
   begin
      if Process /= null then
         Process(h, n);
      end if;
   end Trap_Timer;

   procedure Dispatch (
      this : in out Interactive_Type;
      message : SDL.Events.Event_t;
      cancel_bubble : in out Boolean
      )
   is
   begin
      case message.Ev_Type is
         when SDL.Events.Key_Down =>
            if not this.Disabled then
               On_Key_Down (Virtual(this), message.Key, cancel_bubble);
            end if;
         when SDL.Events.Key_Up =>
            if not this.Disabled then
               On_Key_Up (Virtual(this), message.Key, cancel_bubble);
            end if;
         when SDL.Events.Mouse_Motion =>
            if not this.Disabled then
               On_Mouse_Move (Virtual(this), message.Motion, cancel_bubble);
            end if;
         when SDL.Events.Mouse_Button_Down =>
            if not this.Disabled then
               On_Mouse_Down (Virtual(this), message.Button, cancel_bubble);
            end if;
         when SDL.Events.Mouse_Button_Up =>
            if not this.Disabled then
               On_Mouse_Up (Virtual(this), message.Button, cancel_bubble);
            end if;
         when SDL.Events.Is_User_Event =>
            case message.User.Code is
               when User_Event_Code_Timer =>
                  declare
                     pragma Warnings(Off);
                     h : Hash_Type with Import, Convention => Ada, 
                     Address => message.User.Data1'Address;
                     n : Natural with Import, Convention => Ada,
                     Address => message.User.Data2'Address;
                  begin
                     On_Timer (Virtual(this), h, n, cancel_bubble);
                  end;
               when others =>
                  if not this.Disabled then
                     On_User_Event (Virtual(this), message.User, cancel_bubble);
                  end if;
            end case;
         when SDL.Events.Quit =>
            this.Close;
            cancel_bubble := False;
         when others =>
            cancel_bubble := False;
      end case;
   end Dispatch;

   function Expect_Input (
      this : in out Interactive_Type;
      text : String
      ) return Boolean
   is
      use type Interfaces.C.int;
      use type SDL.Keysym.Key_t;
      ev : aliased SDL.Events.Event_t;
      i : Positive := text'First;
   begin
      loop
         if i > text'Last then
            return True;
         end if;
         exit when SDL.Events.Wait_Event (ev'Unchecked_Access) = 0;
         case ev.Ev_Type is
            when SDL.Events.Key_Down =>
               null;
            when SDL.Events.Key_Up =>
               exit when ev.Key.Keysym.Sym /= Character'Pos(text(i)); 
               i := i + 1;
            when others => 
               Process_Message (this, ev);
         end case;
      end loop;
      return False;
   end Expect_Input;

   function Expect_Char (
      this : in out Interactive_Type;
      Chars : String;
      Default : Character
      ) return Character
   is
      use type Interfaces.C.int;
      use type SDL.Keysym.Key_t;
      ev : aliased SDL.Events.Event_t;
   begin
      loop
         exit when SDL.Events.Wait_Event (ev'Unchecked_Access) = 0;
         case ev.Ev_Type is
            when SDL.Events.Key_Up =>
               declare
                  R : Character := Character'Val(ev.Key.Keysym.Sym);
               begin
                  if (for some C of Chars => R = C) then
                     return R;
                  end if;
               end;
            when others => 
               Process_Message (this, ev);
         end case;
      end loop;
      return Default;
   end Expect_Char;


   function Expect_Number (this : in out Interactive_Type) return String 
   is
      use type Interfaces.C.int;
      use type SDL.Keysym.Key_t;
      ev : aliased SDL.Events.Event_t;
      r : Unbounded_String;
   begin
      loop
         exit when SDL.Events.Wait_Event (ev'Unchecked_Access) = 0;
         case ev.Ev_Type is
            when SDL.Events.Key_Down =>
               null;
            when SDL.Events.Key_Up =>
               exit when ev.Key.Keysym.Sym not in Keysym.K_0 .. Keysym.K_9; 
               Append (r, Character'Val (ev.Key.Keysym.Sym));
            when others => 
               Process_Message (this, ev);
         end case;
      end loop;
      return To_String(r);
   end Expect_Number;

   function Wait_Key_Or_Timeout (
      Timeout : Duration;
      Keys    : Key_Array_Type := (1 .. 0 => <>)
      ) return SDL.Keysym.Key_t
   is
      use Ada.Calendar;
      use SDL.Keysym;
      use type Interfaces.C.int;
      life : Time := Clock + Timeout;
      key_state : Uint8_Ptr_t;
      n         : aliased Interfaces.C.int;
   begin
      while Clock < life loop
         SDL.Events.Pump_Events;
         key_state := SDL.Keyboard.Get_Key_State(n'Unchecked_Access);
         if n > 0 then
            declare
               ks : SDL.Keyboard.Key_States_Array_t 
               with Import, Convention => Ada, Address => key_state.all'Address;
            begin
               if Keys'Length = 0 then
                  for k in ks'Range loop
                     if ks(k) /= 0 then
                        return k;
                     end if;
                  end loop;
               end if;
               for k of Keys loop
                  if ks(k) /= 0 then
                     return k;
                  end if;
               end loop;
            end;
         end if;
         delay 0.05;
      end loop;
      return SDL.Keysym.k_Unknown;
   end Wait_Key_Or_Timeout;

   procedure Run (this : in out Interactive_Type)
   is
      use type Interfaces.C.int;
      ev : aliased SDL.Events.Event_t;
   begin
      this.Active := True;
      this.Canvas.Invalidate; -- force paint first frame
      Interactive_Type'Class(this).On_Before_Run;
      Timers.World_Clock.Add_Timer(
         Interval => Timers.World_Clock_Interval * 2.0, 
         Repeat   => 0, 
         Id       => this.Timer);
      loop
         exit when SDL.Events.Wait_Event(ev'Unchecked_Access) = 0;
         Process_Message(this, ev);
         exit when not this.Active;
      end loop;
      Timers.World_Clock.Delete_Timer(this.Timer);
   end Run;

   procedure Switch_To_Movie_Mode (
      this : in out Interactive_Type;
      Over : not null access function return Boolean
      )
   is
      use type Interfaces.C.int;
      ev : aliased SDL.Events.Event_t;
      old_timer : Hash_Type := this.Timer;
   begin
      this.Disabled := True;
      Timers.World_Clock.Add_Timer(
         Interval => Timers.World_Clock_Interval * 2.0, 
         Repeat   => 0, 
         Id       => this.Timer);
      loop
         exit when SDL.Events.Wait_Event(ev'Unchecked_Access) = 0;
         Process_Message(this, ev);
         exit when Over.all;
      end loop;
      Timers.World_Clock.Delete_Timer(this.Timer);
      this.Disabled := False;
      this.Timer := old_timer;
   end Switch_To_Movie_Mode;

   procedure Close (this : in out Interactive_Type)
   is
   begin
      this.Active := False;
      if this.Parent /= null then
         this.Parent.Canvas.Invalidate;
      end if;
   end Close;

   procedure Wait_Any_Key
   is
      ev : aliased SDL.Events.Event_t;
   begin
      loop
         exit when SDL.Events.Wait_Event(ev'Unchecked_Access) in 0;
         case ev.Ev_Type is
            when SDL.Events.Key_Down => exit;
            when others => null;
         end case;
      end loop;
   end Wait_Any_Key;

   procedure Start_Play_Movie (
      Movie   : in out Movie_Type;
      Expired : Duration := Loop_Infinite
      )
   is
      repeat : Natural := 0; 
   begin
      if Expired /= Duration'Last then
         repeat := Natural((Expired + Movie.Interval) / Movie.Interval);
      end if;
      Timers.World_Clock.Add_Timer(
         Interval => Movie.Interval, 
         Repeat   => repeat, 
         Id       => Movie.Timer);
   end Start_Play_Movie;

   procedure Stop_Play_Movie (movie : in out Movie_Type)
   is
   begin
      Timers.World_Clock.Delete_Timer(movie.Timer);
   end Stop_Play_Movie;



end Legend.Interactives;
